Loading Packages & Initialization

reference : https://gist.github.com/mertedali/ab7078b9c29dea18c72525239d636b96

rm(list=ls())

library(data.table)
library(tidyverse)
library(rJava)
library(RNetLogo)

library(lhs) # For maximin Latin hypercube sampling
library(ggplot2)
library(plotly) # For beautiful plotting
library(caret)
library(randomForest)
library(factoextra)
library(e1071)
library(TSrepr) # for evaluating predictive power

require(gridExtra)

options(warn = -1)

# Select if data generation is wanted
GenerateTTData <- 0

Is_Headless <- 1
nl.model <- "Segregation_OneShot"

nl.path <- "C:/Program Files/NetLogo 6.0.4/app"
model.path <- paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/",nl.model,".nlogo")


if (Is_Headless == 0){
    NLStart(nl.path, gui = TRUE,nl.jarname='netlogo-6.0.4.jar')
    NLLoadModel (model.path)
    } else {
    NLStart(nl.path, gui = FALSE,nl.jarname='netlogo-6.0.4.jar', nl.obj = nl.model)
    NLLoadModel (model.path, nl.obj = nl.model)
    
    #NLStart(nl.path, gui = FALSE,nl.jarname='netlogo-6.0.4.jar', nl.obj = nl.model)
    #NLLoadModel (model.path, nl.obj = nl.model )
    }

Model Parameters & Functions

Set model parameters

## Set model parameters
 # Number of replications for each instance
nofrep = 3   

# Number of iterations
iteration_budget = 21
 # order feature names according to their definition order in run_model
feature_names = c("density","%-similar-wanted")  
 # 
output_name = c("percent-similar")

 # Number of input parameters of the agent-based model
nofparams = length(feature_names)      

# set RF parameters
ntree = 120
mtry = 2

Set user parameters

error_type = "RMSE" # MAPE, BIAS

# choose the uncertainty measure
selection_metric <- "sd" #, "range" 

unlabeled_ins = 700 
test_ins = 400
train_ins_oneshot = 700
train_ins_Ad = 200

# Set selection parameters
selected_ins = 25 #nofinstancesWillbeSelected in each step

# Set elimination parameters
h <- 1 # number of variables eliminated in each step

Define functions

run_model

#run_model <- function(feature_names,feature_values){ # both should be in character list format
run_model <- function(feature_values){ # both should be in character list format

    
    k = length(feature_names)    
    for(i in 1:k){
        NLCommand(paste0("set ",feature_names[i]," ",feature_values[i]), nl.obj = nl.model)      
    }
    NLCommand("setup", nl.obj = nl.model)
    NLDoCommand(100, "go", nl.obj = nl.model) 
    result <- NLReport(output_name, nl.obj = nl.model)
    return(result)   
}

run_replicas

#run_replicas <- function(nofrep,feature_names,feature_values) {
run_replicas <- function(nofrep,feature_values) {
    replicas = matrix(NA, ncol = nofrep, nrow = 1) # Save the result of each replication
    for(i in 1:nofrep){
     #   replicas[i]= run_model(feature_names,feature_values)
        replicas[i]= run_model(feature_values)
    }
    aggregated_result = mean(replicas)
    return(aggregated_result)
}

run_ABM

#run_ABM = function(nofrep,nofinstances,unlabeledset,featurenames = feature_names){
run_ABM = function(nofrep,nofinstances,unlabeledset){
   #unlabeledset = setcolorder(unlabeledset,featurenames) 
   unlabeledset = setcolorder(unlabeledset,feature_names) 
   for(i in 1:nofinstances){
        #unlabeledset[i, output :=  run_replicas(nofrep,featurenames, as.matrix(unlabeledset[i,]))]    
        unlabeledset[i, output :=  run_replicas(nofrep, as.matrix(unlabeledset[i,]))] 
    } 
    return(unlabeledset)
}

error functions

#error functions on test data
rmse_func <- function(actual, predicted){
    error = predicted - actual
    return(sqrt(mean(error^2)))
}

mape_func <- function(actual,predicted){
    return( (abs(actual - predicted)/ actual)*100 )
}

bias_func <- function(actual,predicted){
    return( (actual - predicted)/ actual )
}

#error functions on train data
obb_error_func <- function(model){
   if(model$type == "regression"){
        oob_error = model$mse[model$ntree] 
    }else if(model$type == "classification"){
        oob_error = model$err.rate 
    } 
    return(oob_error)
}

get_test_predictions

# prediction functions
get_test_predictions <- function(model,testset,errortype){
    
    predictedLabels <- predict(model, testset)
    predictedLabels <- cbind(testset,predictedLabels)
    setnames(predictedLabels, "predictedLabels","pred_output")

    output_variables = colnames(select(predictedLabels, contains("output")))
    # output_variables[1] = true output
    # output_variables[2] = predicted output
    
    #output_variables = colnames(predictedLabels[,1:(ncol(predictedLabels) - 2)])
    
    if(error_type == "MAPE"){
        predictedLabels[,MAPE := mapply(function(x,y) mape_func(x,y),get(output_variables[1]),get(output_variables[2]))]
          }
    if(error_type == "RMSE"){
        predictedLabels[,RMSE := mapply(function(x,y) rmse_func(x,y),get(output_variables[1]),get(output_variables[2]))]
          }
    if(error_type == "BIAS"){
        predictedLabels[,BIAS := mapply(function(x,y) bias_func(x,y),get(output_variables[1]),get(output_variables[2]))]
           } 
                                  
     output_variables_1 = predictedLabels[,get(output_variables[1]), with = TRUE]
     output_variables_2 = predictedLabels[,get(output_variables[2]), with = TRUE]
    
     performance_temp = matrix(c(1:3), nrow = 1, ncol = 3)
     performance_temp[1] =  mae(output_variables_1 , output_variables_2)
     performance_temp[2] = rmse(output_variables_1 , output_variables_2)
     performance_temp[3] = mape(output_variables_1 , output_variables_2)
    
    return(list(predictedLabels,performance_temp,output_variables))
    
}

sample_selection

# Adaptive sample selection function with an uncertainty measure depending on "selection_metric"
sample_selection <- function(selected_ins,unlabeled_set,model){   
    ind_pred <- t(predict(model, unlabeled_set,predict.all = TRUE)$individual) %>% 
                data.table() # predictions by each tree in the forest
    ind_pred_eval = data.table()
    
    # standard deviation calculation
    s_dev = sapply(ind_pred, sd) %>% data.table()
    setnames(s_dev,".","sd")
    ind_pred_eval = cbind(ind_pred_eval,s_dev)
    
    # range calculation
    range = sapply(ind_pred, range) %>% t() %>% data.table()
    range = range[,.(range = abs(range[,1] - range[,2]))]
    setnames(range,"range.V1","range")
    ind_pred_eval = cbind(ind_pred_eval,range)
    
    ind_pred_eval[,idx := 1:.N]
    
    if(selection_metric == "sd") {
      ind_pred_eval = ind_pred_eval[order(-sd)][1:selected_ins]
    }else if(selection_metric == "range"){
      ind_pred_eval = ind_pred_eval[order(-range)][1:selected_ins]
    }
    
    unlabeled_set[,idx := 1:.N]    
    train_candidates = unlabeled_set[ind_pred_eval$idx]
    
    return(train_candidates)
}

random_sample_selection

# Random sample selection
random_sample_selection <- function(selected_ins,unlabeled_set){
  
    unlabeled_set[,idx := 1:.N]
    
    train_candidate_idx = sample(unlabeled_set$idx, selected_ins, replace = FALSE, prob = NULL)   
    train_candidates = unlabeled_set[idx %in% train_candidate_idx]
    
    return(train_candidates)
}

get_variable_importance

get_variable_importance <- function(model){
    importances <- importance(model, type = 1, scale = FALSE)
    selected.vars <- order(importances, decreasing = TRUE)
    ranked_features = feature_names[selected.vars]
    ordered.importances <- importances[selected.vars]
    
    return(ranked_features)
}

feature_elimination

feature_elimination <- function(h,total_numof_eliminated_vars,ranked_features){ 
    numof_columns_left = length(ranked_features) - (total_numof_eliminated_vars + h)
    columns_left = ranked_features[1:numof_columns_left]
    
    eliminated_columns = setdiff((length(ranked_features) - total_numof_eliminated_vars), numof_columns_left)
    eliminated_columns = ranked_features[eliminated_columns]
    
    # update total_numof_eliminated_vars
    total_numof_eliminated_vars = length(ranked_features) - length(columns_left)
    
    return(list(columns_left,total_numof_eliminated_vars,h,eliminated_columns))
 }

Generate Unlabeled Data Pool

Latin hyper cube sampling

if(GenerateTTData == 1){
    unlabeled_pool = as.data.table(maximinLHS(n = unlabeled_ins, k = nofparams, dup = 5))
    
    unlabeled_pool$V1 = qunif(unlabeled_pool$V1, 10, 90) 
    unlabeled_pool$V2 = qunif(unlabeled_pool$V2, 10, 90) 
    setnames(unlabeled_pool, c(paste0("V",1:nofparams)), feature_names)
    
    unlabeled_pool[,idx := 1:.N]
        
    fwrite(unlabeled_pool, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/unlabeled_pool_",Sys.Date(),".csv"))
}else{
    unlabeled_pool <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/unlabeled_pool_04122019.csv")   
    unlabeled_pool <- head(unlabeled_pool[`%-similar-wanted` < 90 & `density` < 90],700) 
}

data_candidates =copy(unlabeled_pool)

pca_unlabeled_pool <- princomp(unlabeled_pool[,-c("idx")], cor = TRUE, scores = TRUE)
pca_unlabeled_pool_components <- get_pca_ind(pca_unlabeled_pool)
p_unlabeled_pool <- ggplot(data = data.table(pca_unlabeled_pool_components$coord[,1:2]), aes(x = Dim.1, y = Dim.2)) +
                    geom_point() +
                    labs( title = "") 
p_unlabeled_pool

Generate Test Set

if(GenerateTTData == 1){
    test_set <- head(unlabeled_pool,test_ins)
    ################## Buraya variale'ların datatipine göre bir şeyler yazılabilir
    test_set$density            = runif(test_ins, 10, 90) 
    test_set$`%-similar-wanted` = runif(test_ins, 10, 90) 
    test_set[,c("idx"):= NULL]
       
    print(paste0("ABM run start time : ",Sys.time()))
    test_set = run_ABM(nofrep,test_ins,test_set) %>% as.data.table()
    print(paste0("ABM run end time : ",Sys.time()))
    
    fwrite(test_set, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/test_set_",Sys.Date(),".csv"))
}else{
    test_set <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/test_set_04122019.csv")  
    #below part is only for this .csv
    test_set <- head(test_set[`%-similar-wanted` < 90],800) 
    
    test_set[,idx := 1:.N]    
    test_set_idx = sample(test_set$idx, test_ins, replace = FALSE, prob = NULL)   
    test_set = test_set[idx %in% test_set_idx]
    test_set[,idx:= NULL]
}

10 10 ~ 1 min 100 10 ~ 14 min 900 * 10 ~ 09:16 -- 2019-12-03 07:54:10 +03"

pca_test_set <- princomp(test_set, cor = TRUE, scores = TRUE)
pca_test_set_components <- get_pca_ind(pca_test_set)
p_test_set <- ggplot(data = data.table(pca_test_set_components$coord[,1:2]), aes(x = Dim.1, y = Dim.2)) +
                    geom_point() +
                    labs( title = "") 
p_test_set

Benchmark : One-shot sampling, No feature elimination

Generate Training Set

Select a very big data pool ( nofinstances should be very high ) , like 1000

if(GenerateTTData == 1){
    training_set = as.data.table(maximinLHS(n = train_ins_oneshot, k = nofparams, dup = 5))
    
    training_set$V1 = qunif(training_set$V1, 10, 90) 
    training_set$V2 = qunif(training_set$V2, 10, 90) 
    setnames(training_set, c(paste0("V",1:nofparams)), feature_names)
    
    training_set$output <- 0.00
    
    print(paste0("ABM run start time : ",Sys.time()))
    training_set = run_ABM(nofrep,train_ins_oneshot,LHSample) %>% as.data.table()
    print(paste0("ABM run end time : ",Sys.time()))  
    
    fwrite(training_set, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/training_set_",Sys.Date(),".csv"))
    
}else{
    training_set <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Data_04122019.csv")
    training_set <- head(training_set[`%-similar-wanted` < 90],700)
}

head(FinalTrainData_Rd)
head(training_set)

A data.table: 6 × 3

density	%-similar-wanted	output
<dbl>	<dbl>	<dbl>
47.76660	67.58598	99.70160
54.24280	23.03596	64.43247
83.60312	61.89692	97.98403
73.94153	57.74080	96.33635
29.04253	62.19125	99.06782
63.71408	41.10947	85.30121

A data.table: 6 × 3

density	%-similar-wanted	output
<dbl>	<dbl>	<dbl>
65.01157	43.87938	87.94083
20.74105	85.21169	79.24560
49.87014	34.03143	83.24447
33.43646	22.83971	68.85127
86.36748	61.20240	98.02329
50.03244	59.87073	96.84122

one_shot_data = copy(training_set)

training_set = copy(FinalTrainData_Rd)

Visualization

pca_training_set <- princomp(training_set[,.SD, .SDcols = !c("output")], cor = TRUE, scores = TRUE)

pca_training_set_components <- get_pca_ind(pca_training_set)
pca_training_set_components <-cbind(pca_training_set_components$coord[,1:2],training_set[,.SD, .SDcols = c("output")])
p_training_set <- ggplot(data = pca_training_set_components, aes(x = Dim.1, y = Dim.2)) +
             geom_point(aes(colour = output)) +
             labs( title = "", legend = "output") 
p_training_set

Train & Test Metamodel

model_oneshot <- randomForest(x = training_set[, -c("output")], y = training_set$output, importance = TRUE,ntree = ntree, mtry = mtry)
model_oneshot

Call:
 randomForest(x = training_set[, -c("output")], y = training_set$output,      ntree = ntree, mtry = mtry, importance = TRUE) 
               Type of random forest: regression
                     Number of trees: 120
No. of variables tried at each split: 2

          Mean of squared residuals: 9.568796
                    % Var explained: 96.82

obb_error_oneshot <- obb_error_func(model_oneshot)

#OBB_pred = cbind(training_set$output,model_oneshot$predicted)
#names(OBB_pred) <- c("actual","predicted")

plot(model_oneshot$mse, type="l")

test_prediction_oneshot = get_test_predictions(model_oneshot,test_set,error_type)
predictedLabels_oneshot = test_prediction_oneshot[[1]]

performance_table_oneshot = data.table(iter = numeric(), mae= numeric(),rmse= numeric(), mape = numeric())
# Keep test set error records
performance_table_oneshot = rbind(performance_table_oneshot, data.table(1, test_prediction_oneshot[[2]]), use.names = FALSE)

output_variables = test_prediction_oneshot[[3]]

performance_table_oneshot
obb_error_oneshot
head(predictedLabels_oneshot)

A data.table: 1 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	0.8908736	2.28557	1.29725

9.56879576954223

A data.table: 6 × 5

density	%-similar-wanted	output	pred_output	RMSE
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
39.27182	36.46039	86.97693	86.26176	0.715169836
28.12210	68.05564	99.86504	99.85810	0.006939698
75.80979	17.80044	57.77487	57.74786	0.027003440
57.76825	28.64345	73.81257	72.94059	0.871973723
18.53175	48.03778	93.79242	94.07300	0.280580695
80.09701	42.18455	82.70191	84.04910	1.347192786

performance_molten_oneshot <- melt(data = performance_table_oneshot
                             , id.vars = 'iter')
setnames(performance_molten_oneshot, c("variable","value"),c("errortype","errorvalue"))

p_oneshot <- ggplot(predictedLabels_oneshot,aes(x = get(output_variables[1]), y = get(output_variables[2]), color = (get(output_variables[2]) - get(output_variables[1])))) +
            geom_point() +
            geom_abline() +
            xlab("actual values") +
            ylab("fitted values")

p_oneshot

Random Sampling & No Feature Elimination

Generate Training Set

Select a relatively big data pool ( nofinstances should be medium) , like 400

if(GenerateTTData == 1){
   
    training_set_Ad = as.data.table(maximinLHS(n = train_ins_Ad, k = nofparams, dup = 5))
    
    training_set_Ad$V1 = qunif(training_set_Ad$V1, 10, 90) 
    training_set_Ad$V2 = qunif(training_set_Ad$V2, 10, 90) 
    setnames(training_set_Ad, c(paste0("V",1:nofparams)), feature_names)
    training_set_Ad$output <- 0.00
    
    print(paste0("ABM run start time : ",Sys.time()))
    training_set_Ad = run_ABM(nofrep,train_ins_Ad,training_set_Ad) %>% as.data.table()
    print(paste0("ABM run end time : ",Sys.time()))
    
    fwrite(training_set_Ad, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data",Sys.Date(),".csv"))

}else{
    training_set_Ad <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data_04122019.csv")
    training_set_Ad <- head(training_set_Ad[`%-similar-wanted` < 90  & `density` < 90],200)

}

adaptive_initial_data = copy(training_set_Ad)

Visualization

pca_training_set_Ad <- princomp(adaptive_initial_data[,.SD, .SDcols = !c("output")], cor = TRUE, scores = TRUE)

pca_training_set_Ad_components <- get_pca_ind(pca_training_set_Ad)
pca_training_set_Ad_components <-cbind(pca_training_set_Ad_components$coord[,1:2],adaptive_initial_data[,.SD, .SDcols = c("output")])
p_training_set_Ad <- ggplot(data = pca_training_set_Ad_components, aes(x = Dim.1, y = Dim.2)) +
             geom_point(aes(colour = output)) +
             labs( title = "", legend = "output") 
p_training_set_Ad

Train & Test Metamodel

# Decide on strategy:
#iteration_budget = 3   #specified above

## initialize record tables Record train candidates
train_candidates_table = data.table()

# Record model performances
performance_table = data.table(iter = numeric(), mae = numeric(), rmse = numeric(), mape = numeric())

# Record obb_error table
obb_error = data.table(iter = numeric(), obb_error = numeric())

## initialize variables
# keep test set undistorted
predictedLabels_table = copy(test_set)

set.seed(10)
print(paste0("section start time : ",Sys.time()))
iter = 1
while(iter <= iteration_budget){   
    print(iter)

    trainx = training_set_Ad[,.SD, .SDcols = feature_names]
    trainy = training_set_Ad$output
    
    # Train the model
    model_Sub <- randomForest( x = trainx, y =  trainy,importance = TRUE,ntree = ntree, mtry = mtry)
    assign(paste0("model_Sub_",iter),model_Sub)
                     
    obb_error = rbind(obb_error,data.table(iter,obb_error_func(model_Sub)),use.names=FALSE)
    
    # test the model on test set
    test_predictions_Sub = get_test_predictions(model_Sub,test_set,error_type)
    predictedLabels_Sub = test_predictions_Sub[[1]]
    setnames(predictedLabels_Sub,c("pred_output",error_type), c(paste0("pred_output_",iter),paste0(error_type,"_",iter)))    
    predictedLabels_table = cbind(predictedLabels_table,predictedLabels_Sub[,.SD, .SDcols = c(paste0("pred_output_",iter),paste0(error_type,"_",iter))])
    
    # Keep test set error records
    performance_table = rbind(performance_table,data.table(iter,test_predictions_Sub[[2]]), use.names = FALSE)    

    if(iter != iteration_budget){ # below efforts are unnecessary when the budget is reached.
        
    ## sample selection from unlabeled data select candidates
    unlabeled_set <- copy(unlabeled_pool)
    train_candidates = random_sample_selection(selected_ins,unlabeled_set)
        
    # Eliminate train candidates from the unlabeled pool
    unlabeled_pool = unlabeled_pool[- train_candidates$idx]
    rm(unlabeled_set)
    
    # run ABM to find outputs of train candidates
    print(paste0("ABM train_candidate run start time : ",Sys.time()))
    train_candidates = run_ABM(nofrep,selected_ins,train_candidates)
    print(paste0("ABM train_candidate run end time : ",Sys.time()))
    
    train_candidates_table = rbind(train_candidates_table, data.table(train_candidates,iter = iter))

    # Add new data to train data
    training_set_Ad = rbind(training_set_Ad,train_candidates[,-c("idx")])
    }
    iter = iter + 1
}

# plot koy her iteration'da göstersin.
#setcolorder(data,variableorder) ################# bunu bi yerlere koyman gerekebilir, dikkat!!
print(paste0("section end time : ",Sys.time()))

[1] "section start time : 2020-01-09 07:31:59"
[1] 1
[1] "ABM train_candidate run start time : 2020-01-09 07:31:59"
[1] "ABM train_candidate run end time : 2020-01-09 07:32:42"
[1] 2
[1] "ABM train_candidate run start time : 2020-01-09 07:32:42"
[1] "ABM train_candidate run end time : 2020-01-09 07:33:21"
[1] 3
[1] "ABM train_candidate run start time : 2020-01-09 07:33:21"
[1] "ABM train_candidate run end time : 2020-01-09 07:34:06"
[1] 4
[1] "ABM train_candidate run start time : 2020-01-09 07:34:06"
[1] "ABM train_candidate run end time : 2020-01-09 07:34:41"
[1] 5
[1] "ABM train_candidate run start time : 2020-01-09 07:34:41"
[1] "ABM train_candidate run end time : 2020-01-09 07:35:31"
[1] 6
[1] "ABM train_candidate run start time : 2020-01-09 07:35:31"
[1] "ABM train_candidate run end time : 2020-01-09 07:36:04"
[1] 7
[1] "ABM train_candidate run start time : 2020-01-09 07:36:04"
[1] "ABM train_candidate run end time : 2020-01-09 07:36:37"
[1] 8
[1] "ABM train_candidate run start time : 2020-01-09 07:36:37"
[1] "ABM train_candidate run end time : 2020-01-09 07:37:26"
[1] 9
[1] "ABM train_candidate run start time : 2020-01-09 07:37:26"
[1] "ABM train_candidate run end time : 2020-01-09 07:38:39"
[1] 10
[1] "ABM train_candidate run start time : 2020-01-09 07:38:39"
[1] "ABM train_candidate run end time : 2020-01-09 07:39:49"
[1] 11
[1] "ABM train_candidate run start time : 2020-01-09 07:39:49"
[1] "ABM train_candidate run end time : 2020-01-09 07:40:29"
[1] 12
[1] "ABM train_candidate run start time : 2020-01-09 07:40:29"
[1] "ABM train_candidate run end time : 2020-01-09 07:41:07"
[1] 13
[1] "ABM train_candidate run start time : 2020-01-09 07:41:08"
[1] "ABM train_candidate run end time : 2020-01-09 07:42:14"
[1] 14
[1] "ABM train_candidate run start time : 2020-01-09 07:42:15"
[1] "ABM train_candidate run end time : 2020-01-09 07:42:45"
[1] 15
[1] "ABM train_candidate run start time : 2020-01-09 07:42:45"
[1] "ABM train_candidate run end time : 2020-01-09 07:43:21"
[1] 16
[1] "ABM train_candidate run start time : 2020-01-09 07:43:21"
[1] "ABM train_candidate run end time : 2020-01-09 07:44:18"
[1] 17
[1] "ABM train_candidate run start time : 2020-01-09 07:44:19"
[1] "ABM train_candidate run end time : 2020-01-09 07:45:00"
[1] 18
[1] "ABM train_candidate run start time : 2020-01-09 07:45:00"
[1] "ABM train_candidate run end time : 2020-01-09 07:45:47"
[1] 19
[1] "ABM train_candidate run start time : 2020-01-09 07:45:47"
[1] "ABM train_candidate run end time : 2020-01-09 07:46:47"
[1] 20
[1] "ABM train_candidate run start time : 2020-01-09 07:46:47"
[1] "ABM train_candidate run end time : 2020-01-09 07:47:18"
[1] 21
[1] "section end time : 2020-01-09 07:47:18"

started : 2020-01-09 07:31:59 // ended : 2020-01-09 07:47:18 // 3 nofrep 25 sample 20 selection iter = 1500 runs

# Final records
FinalTrainData_Rd = copy(training_set_Ad)
performance_table_Rd = copy(performance_table)
train_candidates_table_Rd  = copy(train_candidates_table)
predictedLabels_table_Rd = copy(predictedLabels_table)
obb_error_Rd = copy(obb_error)

#fwrite(FinalTrainData_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/FinalTrainData_Rd_BasicCode_OneShot_120tree_",Sys.Date(),".csv") )
#fwrite(performance_table_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/performance_table_Rd_BasicCode_OneShot_120tree_",Sys.Date(),".csv") )
#fwrite(train_candidates_table_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/train_candidates_table_Rd_BasicCode_OneShot_120tree_",Sys.Date(),".csv") )
#fwrite(predictedLabels_table_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/predictedLabels_table_Rdd_BasicCode_OneShot_120tree_",Sys.Date(),".csv") )
#fwrite(obb_error_Rd,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/obb_error_Rd_BasicCode_OneShot_120tree_",Sys.Date(),".csv") )

# show results
nrow(FinalTrainData_Rd)
performance_table_Rd 
train_candidates_table_Rd  
head(predictedLabels_table_Rd)
obb_error_Rd

700

A data.table: 21 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	2.098431	4.726630	3.057153
2	1.981412	4.570033	2.873256
3	1.761173	4.212072	2.544558
4	1.708033	4.209987	2.490380
5	1.650386	4.095514	2.394935
6	1.690283	4.275809	2.485206
7	1.577566	4.153829	2.326456
8	1.570771	4.365468	2.319439
9	1.524981	4.338566	2.241223
10	1.477584	4.300532	2.182432
11	1.469394	4.431848	2.176106
12	1.458350	4.403979	2.151240
13	1.465307	4.369526	2.170581
14	1.426205	4.318267	2.106937
15	1.429165	4.417180	2.119063
16	1.331120	4.149063	1.991292
17	1.318958	4.091322	1.971553
18	1.286099	4.086385	1.914302
19	1.238944	3.977863	1.852718
20	1.253460	3.997953	1.871194
21	1.217953	3.942170	1.819841

A data.table: 500 × 5

density	%-similar-wanted	idx	output	iter
<dbl>	<dbl>	<int>	<dbl>	<dbl>
60.36789	55.42004	73	95.27955	1
73.35104	29.16321	133	72.33457	1
21.25381	21.63017	135	76.58534	1
71.80179	20.57627	143	61.70800	1
15.44810	70.93662	148	100.00000	1
59.79872	39.86570	150	81.94666	1
52.15756	18.57792	151	58.67614	1
36.37558	37.53732	155	88.15160	1
32.49947	19.08426	163	65.36646	1
65.75728	87.75657	213	50.76714	1
40.05386	25.70328	243	74.73709	1
37.50527	56.35875	264	97.46138	1
61.21467	20.74994	287	63.60936	1
78.04841	44.68347	304	87.03161	1
59.23842	13.39637	327	54.03447	1
63.23602	84.93076	375	51.82498	1
72.77920	73.39243	379	97.76031	1
40.63874	57.30135	385	97.05972	1
16.69670	52.17594	436	99.46422	1
43.28615	82.95672	473	55.21606	1
25.12362	14.93195	490	72.39845	1
31.84523	63.90615	505	98.98594	1
85.84484	88.20989	542	50.41578	1
16.64601	57.05713	640	99.70481	1
21.93770	16.78390	651	73.69601	1
75.07979	52.73906	49	94.20838	2
34.60035	72.34013	59	99.81659	2
27.63749	20.46809	74	71.03974	2
19.02491	17.32867	199	79.36224	2
18.44850	58.86279	205	99.27576	2
...	...	...	...	...
68.87781	26.25414	210	67.12226	19
60.46269	23.60738	211	62.90753	19
28.83171	13.68594	226	69.51367	19
13.26555	62.04142	233	99.85316	19
51.54346	34.70113	247	83.99942	19
22.88652	25.02460	11	83.47654	20
27.79660	45.41240	24	91.73179	20
37.27228	18.42808	27	63.85914	20
36.59009	12.41078	30	61.92311	20
59.94861	65.89318	34	98.59082	20
41.83807	78.67310	53	72.33967	20
19.84825	29.66990	56	85.31073	20
43.10967	25.65882	63	74.82546	20
44.32204	28.22947	76	74.41214	20
11.61942	44.64752	88	96.70463	20
70.13502	69.01784	91	99.65509	20
56.35122	12.24678	92	56.67776	20
86.38598	47.45947	97	86.43969	20
75.00809	40.72460	99	83.84039	20
54.75810	76.58287	104	63.70811	20
29.78481	38.26384	105	89.48297	20
17.68225	45.85307	107	94.99373	20
71.10723	63.14608	108	98.27836	20
47.86169	41.86628	141	88.76012	20
50.33188	20.38087	156	65.92042	20
38.95489	50.40294	162	97.54646	20
83.90966	27.77719	188	64.82842	20
63.02590	47.65941	190	88.58334	20
40.72171	42.00045	192	90.54712	20
27.67541	40.39230	218	92.32217	20

A data.table: 6 × 45

density	%-similar-wanted	output	pred_output_1	RMSE_1	pred_output_2	RMSE_2	pred_output_3	RMSE_3	pred_output_4	...	pred_output_17	RMSE_17	pred_output_18	RMSE_18	pred_output_19	RMSE_19	pred_output_20	RMSE_20	pred_output_21	RMSE_21
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	...	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
39.27182	36.46039	86.97693	85.09648	1.88044819	85.34849	1.628433531	85.10414	1.87278053	86.21958	...	86.26288	0.7140478	86.05423	0.92269358	86.08842	0.88850865	85.65860	1.31832725	86.45438	0.52254090
28.12210	68.05564	99.86504	99.85598	0.00906429	99.85879	0.006250425	99.87824	0.01320241	99.85118	...	99.83879	0.0262481	99.85184	0.01320454	99.83993	0.02510859	99.84557	0.01947629	99.84704	0.01800473
75.80979	17.80044	57.77487	58.07941	0.30453968	57.82570	0.050836793	57.24385	0.53101734	57.36777	...	58.26167	0.4868022	58.22840	0.45353399	58.22233	0.44746472	58.37953	0.60466054	58.23139	0.45652110
57.76825	28.64345	73.81257	72.92002	0.89254967	72.71520	1.097361044	72.71770	1.09486313	72.74901	...	70.78827	3.0242938	71.18102	2.63154765	72.38665	1.42591967	72.39685	1.41571145	71.97328	1.83928304
18.53175	48.03778	93.79242	94.06373	0.27130985	94.07787	0.285453733	94.41845	0.62602902	94.39578	...	94.36839	0.5759708	94.26354	0.47112308	94.24892	0.45650141	94.32667	0.53425224	94.37487	0.58245296
80.09701	42.18455	82.70191	85.22908	2.52716574	85.11109	2.409183801	86.14283	3.44092102	84.81016	...	83.39363	0.6917205	83.54566	0.84375395	83.50449	0.80258309	83.23984	0.53792495	83.70402	1.00210456

A data.table: 21 × 2

iter	obb_error
<dbl>	<dbl>
1	15.080129
2	11.680522
3	7.997086
4	7.661824
5	7.335193
6	11.921274
7	10.506279
8	7.658411
9	7.464558
10	6.744633
11	5.575077
12	5.011367
13	5.432426
14	5.002948
15	5.007190
16	4.579059
17	4.424223
18	2.817256
19	2.983130
20	3.325246
21	2.966596

performance_molten_Rd <- melt(data = performance_table_Rd
                             , id.vars = 'iter')
setnames(performance_molten_Rd, c("variable","value"),c("errortype","errorvalue"))
p_Rd = ggplot(performance_molten_Rd, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
          geom_line(lwd=1) +
          geom_hline(data = performance_molten_oneshot, aes(yintercept = errorvalue, group=errortype, col=errortype),stat = "hline", linetype = "dashed")
p_Rd

Final Visualization

pca_final_Rd_training_set <- princomp(FinalTrainData_Rd[,.SD, .SDcols = !c("output")], cor = TRUE, scores = TRUE)

pca_final_Rd_training_set_components <- get_pca_ind(pca_final_Rd_training_set)
pca_final_Rd_training_set_components <-cbind(pca_final_Rd_training_set_components$coord[,1:2],FinalTrainData_Rd[,.SD, .SDcols = c("output")])
p_final_Rd_training_set <- ggplot(data = pca_final_Rd_training_set_components, aes(x = Dim.1, y = Dim.2)) +
             geom_point(aes(colour = output)) +
             labs( title = "", legend = "output") 
p_final_Rd_training_set

grid.arrange(p_training_set_Ad,p_final_Rd_training_set, ncol=2)

Adaptive Sampling & No Feature Elimination

Generate Training Set

Select a relatively big data pool ( nofinstances should be medium) , like 400

training_set_Ad = copy(adaptive_initial_data)
unlabeled_pool =copy(data_candidates)

#if(GenerateTTData == 1){
#   
#    LHSample_Ad = as.data.table(maximinLHS(n = train_ins_Ad, k = nofparams, dup = 5))
#    
#    LHSample_Ad$V1 = qunif(LHSample_Ad$V1, 10, 90) 
#    LHSample_Ad$V2 = qunif(LHSample_Ad$V2, 10, 90) 
#    setnames(LHSample_Ad, c("V1","V2"), feature_names)
#    LHSample_Ad$output <- 0.00
#    
#    paste0("ABM run start time : ",Sys.time())
#    LHSample_Ad = run_ABM(nofrep,train_ins_Ad,LHSample_Ad) %>% as.data.table()
#    paste0("ABM run end time : ",Sys.time())
#    
#    fwrite(LHSample_Ad, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data",Sys.Date(),".csv"))
#
#}else{
#    LHSample_Ad <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data_04122019.csv")
#    LHSample_Ad <- head(LHSample_Ad[`%-similar-wanted` < 90  & `density` < 90],200)
#
#}

Visualization

pca_training_set_Ad <- princomp(training_set_Ad[,-c("output")], cor = TRUE, scores = TRUE)

#fviz_pca_ind(pca_LHSample,
#             col.ind = "cos2", # Color by the quality of representation
#             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
#              geom="point"
#             )

pca_training_set_Ad_components <- get_pca_ind(pca_training_set_Ad)
pca_training_set_Ad_components <-cbind(pca_training_set_Ad_components$coord[,1:2],training_set_Ad[,c("output")])
p_training_set_Ad <- ggplot(data = pca_training_set_Ad_components, aes(x = Dim.1, y = Dim.2)) +
                     geom_point(aes(colour = output)) +
                     labs( title = "", legend = "output") 
p_training_set_Ad

Train & Test Metamodel

# Decide on strategy:
#iteration_budget = 3

#h = 1 # specify how many variable will be eliminated in each elimination iteration

## initialize record tables Record train candidates
train_candidates_table = data.table()

# Record model performances
performance_table = data.table(iter = numeric(), mae = numeric(), rmse = numeric(), mape = numeric())

# Record obb_error table
obb_error = data.table(iter = numeric(), obb_error = numeric())

## initialize variables
# keep test set undistorted
predictedLabels_table = copy(test_set)

set.seed(10)
print(paste0("section start time : ",Sys.time()))
iter = 1
while(iter <= iteration_budget){   
    print(iter)

    trainx = training_set_Ad[,.SD, .SDcols = feature_names]
    trainy = training_set_Ad$output
    
    # Train the model
    model_Sub <- randomForest( x = trainx, y =  trainy,importance = TRUE,ntree = ntree, mtry = mtry)
    assign(paste0("model_Sub_",iter),model_Sub)
                    
    obb_error = rbind(obb_error,data.table(iter,obb_error_func(model_Sub)),use.names=FALSE)

    # test the model on test set
    test_predictions_Sub = get_test_predictions(model_Sub,test_set,error_type)
    predictedLabels_Sub = test_predictions_Sub[[1]]
    setnames(predictedLabels_Sub,c("pred_output",error_type), c(paste0("pred_output_",iter),paste0(error_type,"_",iter)))    
    predictedLabels_table = cbind(predictedLabels_table,predictedLabels_Sub[,.SD, .SDcols = c(paste0("pred_output_",iter),paste0(error_type,"_",iter))])
    
    # Keep test set error records
    performance_table = rbind(performance_table,data.table(iter,test_predictions_Sub[[2]]), use.names = FALSE)
    
    if(iter != iteration_budget){ # below efforts are unnecessary when the budget is reached.    
    ## sample selection from unlabeled data select candidates
        unlabeled_set <- copy(unlabeled_pool)
        train_candidates = sample_selection(selected_ins, unlabeled_set, model_Sub)
        
        # eliminate candidates from the unlabeled pool
        unlabeled_pool = unlabeled_pool[-train_candidates$idx]
        rm(unlabeled_set)
        
        # run ABM to find outputs of train candidates
        print(paste0("ABM train_candidate run start time : ",Sys.time()))
        train_candidates = run_ABM(nofrep, selected_ins, train_candidates)
        print(paste0("ABM train_candidate run end time : ",Sys.time()))
        
        train_candidates_table = rbind(train_candidates_table, data.table(train_candidates,iter = iter))
        
        # add labeled candidates to the train data
        training_set_Ad = rbind(training_set_Ad, train_candidates[, -c("idx")])
    }
    iter = iter + 1
}
print(paste0("section end time : ",Sys.time()))

[1] "section start time : 2020-01-09 07:50:25"
[1] 1
[1] "ABM train_candidate run start time : 2020-01-09 07:50:25"
[1] "ABM train_candidate run end time : 2020-01-09 07:51:31"
[1] 2
[1] "ABM train_candidate run start time : 2020-01-09 07:51:31"
[1] "ABM train_candidate run end time : 2020-01-09 07:52:11"
[1] 3
[1] "ABM train_candidate run start time : 2020-01-09 07:52:11"
[1] "ABM train_candidate run end time : 2020-01-09 07:53:23"
[1] 4
[1] "ABM train_candidate run start time : 2020-01-09 07:53:23"
[1] "ABM train_candidate run end time : 2020-01-09 07:53:56"
[1] 5
[1] "ABM train_candidate run start time : 2020-01-09 07:53:56"
[1] "ABM train_candidate run end time : 2020-01-09 07:55:01"
[1] 6
[1] "ABM train_candidate run start time : 2020-01-09 07:55:01"
[1] "ABM train_candidate run end time : 2020-01-09 07:55:36"
[1] 7
[1] "ABM train_candidate run start time : 2020-01-09 07:55:36"
[1] "ABM train_candidate run end time : 2020-01-09 07:56:24"
[1] 8
[1] "ABM train_candidate run start time : 2020-01-09 07:56:24"
[1] "ABM train_candidate run end time : 2020-01-09 07:57:03"
[1] 9
[1] "ABM train_candidate run start time : 2020-01-09 07:57:03"
[1] "ABM train_candidate run end time : 2020-01-09 07:58:08"
[1] 10
[1] "ABM train_candidate run start time : 2020-01-09 07:58:08"
[1] "ABM train_candidate run end time : 2020-01-09 07:58:57"
[1] 11
[1] "ABM train_candidate run start time : 2020-01-09 07:58:57"
[1] "ABM train_candidate run end time : 2020-01-09 07:59:27"
[1] 12
[1] "ABM train_candidate run start time : 2020-01-09 07:59:27"
[1] "ABM train_candidate run end time : 2020-01-09 08:00:03"
[1] 13
[1] "ABM train_candidate run start time : 2020-01-09 08:00:03"
[1] "ABM train_candidate run end time : 2020-01-09 08:00:36"
[1] 14
[1] "ABM train_candidate run start time : 2020-01-09 08:00:37"
[1] "ABM train_candidate run end time : 2020-01-09 08:01:05"
[1] 15
[1] "ABM train_candidate run start time : 2020-01-09 08:01:05"
[1] "ABM train_candidate run end time : 2020-01-09 08:01:38"
[1] 16
[1] "ABM train_candidate run start time : 2020-01-09 08:01:38"
[1] "ABM train_candidate run end time : 2020-01-09 08:02:13"
[1] 17
[1] "ABM train_candidate run start time : 2020-01-09 08:02:13"
[1] "ABM train_candidate run end time : 2020-01-09 08:03:06"
[1] 18
[1] "ABM train_candidate run start time : 2020-01-09 08:03:07"
[1] "ABM train_candidate run end time : 2020-01-09 08:03:56"
[1] 19
[1] "ABM train_candidate run start time : 2020-01-09 08:03:56"
[1] "ABM train_candidate run end time : 2020-01-09 08:04:34"
[1] 20
[1] "ABM train_candidate run start time : 2020-01-09 08:04:35"
[1] "ABM train_candidate run end time : 2020-01-09 08:05:12"
[1] 21
[1] "section end time : 2020-01-09 08:05:12"

started : 2020-01-09 07:50:25 // ended : 2020-01-09 08:05:12 // 3 nofrep 25 sample 20 selection iter = 1500 runs

# Final records
FinalTrainData_Ad = copy(training_set_Ad)
performance_table_Ad = copy(performance_table)
train_candidates_table_Ad  = copy(train_candidates_table)
predictedLabels_table_Ad = copy(predictedLabels_table)
obb_error_Ad = copy(obb_error)

fwrite(FinalTrainData_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/FinalTrainData_Ad_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
fwrite(performance_table_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/performance_table_Ad_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
fwrite(train_candidates_table_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/train_candidates_table_Ad_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
fwrite(predictedLabels_table_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/predictedLabels_table_Ad_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
fwrite(obb_error_Ad,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/obb_error_Ad_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )

nrow(FinalTrainData_Ad)
performance_table_Ad
train_candidates_table_Ad
head(predictedLabels_table_Ad)
obb_error_Ad

700

A data.table: 21 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	2.098431	4.726630	3.057153
2	1.859375	4.093794	2.644220
3	1.620871	4.108958	2.385732
4	1.488399	3.750737	2.198436
5	1.427667	3.729329	2.122453
6	1.403866	3.746627	2.092942
7	1.353648	3.741495	2.024827
8	1.325721	3.712259	1.974942
9	1.233714	3.602602	1.840287
10	1.238521	3.659166	1.841446
11	1.209546	3.604981	1.797331
12	1.205079	3.615837	1.791390
13	1.176236	3.592117	1.753406
14	1.128457	3.555940	1.687339
15	1.142221	3.572188	1.707218
16	1.143359	3.606123	1.709295
17	1.141829	3.597985	1.698115
18	1.119685	3.605247	1.669113
19	1.134913	3.602788	1.691683
20	1.124972	3.573437	1.668677
21	1.089651	3.570274	1.622426

A data.table: 500 × 5

density	%-similar-wanted	idx	output	iter
<dbl>	<dbl>	<int>	<dbl>	<dbl>
79.18638	74.59114	511	80.49105	1
52.51502	74.99535	136	99.78008	1
66.32434	74.85613	195	99.69076	1
17.79868	75.83541	240	99.21569	1
70.47861	76.76088	60	56.37154	1
77.59878	77.15022	347	53.75866	1
38.04839	74.89497	270	99.77792	1
20.37012	75.14078	525	89.08438	1
66.09709	77.64091	576	56.00802	1
22.23156	89.17194	561	68.67053	1
21.60726	85.95121	416	71.44169	1
49.52896	75.20317	16	64.67290	1
44.18873	76.62527	247	66.89919	1
49.02309	77.00174	209	69.10450	1
51.83401	77.29802	581	64.31714	1
61.35303	75.38737	173	57.12617	1
54.75810	76.58287	306	65.93696	1
23.96343	87.89434	84	65.43082	1
82.76068	76.43015	154	52.80805	1
41.29254	75.91780	631	72.33645	1
88.90310	74.19145	8	76.27434	1
24.96805	74.65329	580	99.96553	1
32.15096	76.26948	460	77.33648	1
57.48774	75.70978	317	58.78205	1
19.79348	83.22548	649	89.59064	1
33.83885	79.30846	179	78.31854	2
20.98484	80.97271	175	78.85116	2
12.27218	12.10815	19	90.61974	2
14.15759	13.42712	533	84.39605	2
15.58944	11.77994	80	82.33798	2
...	...	...	...	...
84.21359	66.47530	91	98.18086	19
36.49932	43.63156	37	90.57619	19
72.47860	32.80387	81	71.91110	19
80.11843	11.24148	138	51.10648	19
74.21415	11.90821	156	51.45607	19
61.66385	14.98947	205	54.60522	20
63.74635	37.62292	33	80.28840	20
50.65858	55.64619	126	96.23175	20
52.44171	54.98247	9	95.92505	20
88.32188	45.35715	198	85.72864	20
51.34645	52.61536	203	96.29543	20
71.01396	10.83699	210	52.08201	20
49.75055	57.86407	41	96.74116	20
53.40315	22.98467	115	64.53042	20
53.04570	57.57226	190	96.73162	20
71.49178	60.71702	62	98.37022	20
29.68287	44.16575	173	91.62217	20
22.77537	41.71400	194	94.06483	20
46.07824	53.19115	174	97.08991	20
45.54165	58.06024	58	97.11986	20
73.47166	82.75609	176	51.35386	20
46.10184	60.52952	165	98.93830	20
80.33674	30.65946	70	71.83737	20
41.22047	60.16733	212	98.78573	20
44.96597	88.66144	50	53.23363	20
30.87081	46.04277	32	91.85324	20
57.31049	48.56326	112	88.78857	20
48.54678	51.73439	107	96.21216	20
82.62886	31.92536	196	73.51695	20
69.03253	52.75876	142	94.42344	20

A data.table: 6 × 45

density	%-similar-wanted	output	pred_output_1	RMSE_1	pred_output_2	RMSE_2	pred_output_3	RMSE_3	pred_output_4	...	pred_output_17	RMSE_17	pred_output_18	RMSE_18	pred_output_19	RMSE_19	pred_output_20	RMSE_20	pred_output_21	RMSE_21
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	...	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
39.27182	36.46039	86.97693	85.09648	1.88044819	85.08702	1.88990963	85.35318	1.62374792	87.29795	...	86.10360	0.87332991	86.24232	0.73460158	86.13812	0.83880613	86.16466	0.81226878	86.09525	0.88167326
28.12210	68.05564	99.86504	99.85598	0.00906429	99.87589	0.01085049	99.88775	0.02270882	99.85919	...	99.85092	0.01411977	99.89878	0.03373267	99.89524	0.03019831	99.90165	0.03660414	99.88404	0.01899542
75.80979	17.80044	57.77487	58.07941	0.30453968	58.06844	0.29357218	58.07288	0.29801479	58.01455	...	58.26936	0.49449434	58.31443	0.53955758	58.20851	0.43364434	58.11287	0.33800311	58.26916	0.49429048
57.76825	28.64345	73.81257	72.92002	0.89254967	72.81823	0.99433760	72.56356	1.24900471	72.94710	...	72.09488	1.71768664	72.32781	1.48475839	72.24309	1.56948021	72.19036	1.62220527	72.27469	1.53787091
18.53175	48.03778	93.79242	94.06373	0.27130985	94.10400	0.31158053	94.27468	0.48225806	94.59044	...	94.46940	0.67698362	94.51822	0.72580294	94.55704	0.76462251	94.50067	0.70825353	94.61872	0.82629938
80.09701	42.18455	82.70191	85.22908	2.52716574	85.22995	2.52803980	85.37950	2.67758893	85.30000	...	82.97070	0.26878467	83.07368	0.37176974	83.15700	0.45509087	83.19541	0.49349669	83.10918	0.40726512

A data.table: 21 × 2

iter	obb_error
<dbl>	<dbl>
1	15.080129
2	14.570913
3	10.507075
4	10.546756
5	8.803361
6	8.018189
7	7.473081
8	6.942357
9	6.331387
10	6.111400
11	5.501289
12	5.338440
13	5.219288
14	5.539184
15	4.926805
16	4.932839
17	4.366652
18	4.887069
19	3.941157
20	4.168353
21	4.390004

performance_molten_Ad <- melt(data = performance_table_Ad
                             , id.vars = 'iter')
setnames(performance_molten_Ad, c("variable","value"),c("errortype","errorvalue"))
p_Ad = ggplot(performance_molten_Ad, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1)+
          geom_hline(data = performance_molten_oneshot, aes(yintercept = errorvalue, group=errortype, col=errortype),stat = "hline", linetype = "dashed")

p_Ad

Final Visualization

pca_final_Ad_training_set <- princomp(FinalTrainData_Ad[,.SD, .SDcols = !c("output")], cor = TRUE, scores = TRUE)

pca_final_Ad_training_set_components <- get_pca_ind(pca_final_Ad_training_set)
pca_final_Ad_training_set_components <-cbind(pca_final_Ad_training_set_components$coord[,1:2],FinalTrainData_Ad[,.SD, .SDcols = c("output")])
p_final_Ad_training_set <- ggplot(data = pca_final_Ad_training_set_components, aes(x = Dim.1, y = Dim.2)) +
             geom_point(aes(colour = output)) +
             labs( title = "", legend = "output") 
p_final_Ad_training_set

grid.arrange(p_training_set_Ad,p_final_Ad_training_set, ncol=2)

3 scenarios

nrow(FinalTrainData_Ad)
nrow(training_set)
nrow(FinalTrainData_Rd)

700

700

700

oneshot_model = randomForest( x = training_set[, -c("output")]
                             ,y = training_set$output
                             , importance = TRUE,ntree = ntree, mtry = mtry)
random_model = randomForest( x = FinalTrainData_Rd[,.SD, .SDcols = feature_names]
                              ,y = FinalTrainData_Rd$output
                              ,importance = TRUE,ntree = ntree, mtry = mtry)
adaptive_model = randomForest( x = FinalTrainData_Ad[,.SD, .SDcols = feature_names]
                              ,y = FinalTrainData_Ad$output
                              ,importance = TRUE,ntree = ntree, mtry = mtry)

oneshot_model
random_model
adaptive_model

Call:
 randomForest(x = training_set[, -c("output")], y = training_set$output,      ntree = ntree, mtry = mtry, importance = TRUE) 
               Type of random forest: regression
                     Number of trees: 120
No. of variables tried at each split: 2

          Mean of squared residuals: 9.648594
                    % Var explained: 96.8

Call:
 randomForest(x = FinalTrainData_Rd[, .SD, .SDcols = feature_names],      y = FinalTrainData_Rd$output, ntree = ntree, mtry = mtry,      importance = TRUE) 
               Type of random forest: regression
                     Number of trees: 120
No. of variables tried at each split: 2

          Mean of squared residuals: 3.34362
                    % Var explained: 98.87

Call:
 randomForest(x = FinalTrainData_Ad[, .SD, .SDcols = feature_names],      y = FinalTrainData_Ad$output, ntree = ntree, mtry = mtry,      importance = TRUE) 
               Type of random forest: regression
                     Number of trees: 120
No. of variables tried at each split: 2

          Mean of squared residuals: 4.010939
                    % Var explained: 98.5

pred_oneshot <- predict(oneshot_model, test_set)
pred_oneshot <- cbind(test_set,pred_oneshot)

pred_rd <- predict(random_model, test_set)
pred_rd <- cbind(test_set,pred_rd)

pred_ad <- predict(adaptive_model, test_set)
pred_ad <- cbind(test_set,pred_ad)

pred_oneshot[,RMSE := mapply(function(x,y) rmse_func(x,y),output,pred_oneshot)]
pred_rd[,RMSE := mapply(function(x,y) rmse_func(x,y),output,pred_rd)]
pred_ad[,RMSE := mapply(function(x,y) rmse_func(x,y),output,pred_ad)]

rmse(pred_oneshot$output,pred_oneshot$pred_oneshot)
rmse(pred_rd$output,pred_rd$pred_rd)
rmse(pred_ad$output,pred_ad$pred_ad)

2.16127288713123

4.02974568509003

3.56785097720262

plot(oneshot_model$mse, type="l")
plot(random_model$mse, type="l")
plot(adaptive_model$mse, type="l")

Random Sampling vs Uncertainty Sampling

Final Data Comparison

grid.arrange(p_training_set, p_training_set_Ad,p_final_Rd_training_set,p_final_Ad_training_set,nrow=2, ncol=2)

Performance Comparison

grid.arrange(p_Rd, p_Ad, ncol=2)

performance_Rd_vs_Ad = rbind(performance_molten_Rd[,.(iter,errortype,errorvalue, type = "Rd")],performance_molten_Ad[,.(iter,errortype,errorvalue, type = "Ad")])
p_Rd_vs_Ad = ggplot(performance_Rd_vs_Ad, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1) +
            geom_hline(data = performance_molten_oneshot, aes(yintercept = errorvalue, group=errortype, col=errortype),stat = "hline", linetype = "dashed") +
            facet_wrap(~type)
p_Rd_vs_Ad

ggplotly(p_Rd_vs_Ad)

comp = performance_Rd_vs_Ad[iter == 20 & errortype =="rmse"]
comp[, oneshot_error := performance_molten_oneshot[errortype =="rmse"]$errorvalue]      
comp[,diff := (errorvalue - oneshot_error) ]
comp[,diff_perc := (errorvalue - oneshot_error) / oneshot_error ]
comp

A data.table: 2 × 7

iter	errortype	errorvalue	type	oneshot_error	diff	diff_perc
<dbl>	<fct>	<dbl>	<chr>	<dbl>	<dbl>	<dbl>
20	rmse	3.997953	Rd	2.257466	1.740487	0.7709913
20	rmse	3.573437	Ad	2.257466	1.315971	0.5829418

Adaptive Sampling & Feature Elimination

Generate Training Set

Select a relatively big data pool ( nofinstances should be medium) , like 400

training_set_Ad = copy(adaptive_initial_data)
unlabeled_pool =copy(data_candidates)

#if(GenerateTTData == 1){
#   
#    LHSample_Ad = as.data.table(maximinLHS(n = train_ins_Ad, k = nofparams, dup = 5))
#    
#    LHSample_Ad$V1 = qunif(LHSample_Ad$V1, 10, 90) 
#    LHSample_Ad$V2 = qunif(LHSample_Ad$V2, 10, 90) 
#    setnames(LHSample_Ad, c("V1","V2"), feature_names)
#    LHSample_Ad$output <- 0.00
#    
#    paste0("ABM run start time : ",Sys.time())
#    LHSample_Ad = run_ABM(nofrep,train_ins_Ad,LHSample_Ad) %>% as.data.table()
#    paste0("ABM run end time : ",Sys.time())
#    
#    fwrite(LHSample_Ad, paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data",Sys.Date(),".csv"))
#
#}else{
#    LHSample_Ad <- fread("C:/Users/paslanpatir/Desktop/TEZ_v2/LHSample_Ad_Data_04122019.csv")
#    LHSample_Ad <- head(LHSample_Ad[`%-similar-wanted` < 90  & `density` < 90],200)
#
#}

Visualization

pca_training_set_Ad <- princomp(training_set_Ad[,-c("output")], cor = TRUE, scores = TRUE)

#fviz_pca_ind(pca_LHSample,
#             col.ind = "cos2", # Color by the quality of representation
#             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
#              geom="point"
#             )

pca_training_set_Ad_components <- get_pca_ind(pca_training_set_Ad)
pca_training_set_Ad_components <-cbind(pca_training_set_Ad_components$coord[,1:2],training_set_Ad[,c("output")])
p_training_set_Ad <- ggplot(data = pca_training_set_Ad_components, aes(x = Dim.1, y = Dim.2)) +
                     geom_point(aes(colour = output)) +
                     labs( title = "", legend = "output") 
p_training_set_Ad

Train and Test Metamodel

# Decide on strategy:
sample_selection_iteration_order = c(1:20)
feature_elimination_iteration_order = c(20)
#iteration_budget = 3 # should be > max(max(sample_selection_iteration_order),max(feature_elimination_iteration_order))

#h = 1 # specify how many variable will be eliminated in each elimination iteration

feature_names

1. 'density'
2. '%-similar-wanted'

## initialize record tables Record train candidates
train_candidates_table = data.table()

# Record model performances
performance_table = data.table(iter = numeric(), mae = numeric(), rmse = numeric(), mape = numeric())

# Record obb_error table
obb_error = data.table(iter = numeric(), obb_error = numeric())

# Record iteration history
iteration_history = data.table(iter_no = numeric(), IsFeatureEliminated = logical(), IsDataSelected = logical())

## initialize variables
# keep test set undistorted
predictedLabels_table = copy(test_set)

# specify variables(columns) to be used initialize
columns_left = feature_names
total_numof_eliminated_vars <- 0

set.seed(10)
print(paste0("section start time : ",Sys.time()))
iter = 1
while (iter <= iteration_budget) {
    
    trainx = training_set_Ad[, .SD, .SDcols = columns_left]
    trainy = training_set_Ad$output
    
    # Train the model
    model_Sub <- randomForest(x = trainx, y = trainy, importance = TRUE, ntree = ntree, mtry = mtry)
    assign(paste0("model_Sub_", iter), model_Sub)
    
    if (length(columns_left) == length(feature_names)) {
        ranked_features = get_variable_importance(model_Sub)
    }
    # Keep training set error records
    obb_error = rbind(obb_error, data.table(iter, obb_error_func(model_Sub)), use.names = FALSE)
    
    # Test the model on test set
    test_predictions_Sub = get_test_predictions(model_Sub, test_set, error_type)
    predictedLabels_Sub = test_predictions_Sub[[1]]
    setnames(predictedLabels_Sub, c("pred_output", error_type), c(paste0("pred_output_", iter), paste0(error_type, "_", iter)))
    predictedLabels_table = cbind(predictedLabels_table, predictedLabels_Sub[,.SD, .SDcols = c(paste0("pred_output_", iter), paste0(error_type, "_", iter))])
    
    # Keep test set error records
    performance_table = rbind(performance_table, data.table(iter, test_predictions_Sub[[2]]), use.names = FALSE)
    
    # update iteration_history
    iteration_history = rbind(iteration_history, data.table(iter, 0, 0), use.names = FALSE)
    
    if(iter != iteration_budget){ # below efforts are unnecessary when the budget is reached.
          if (iter %in% sample_selection_iteration_order) {
              ## sample selection from unlabeled data select candidates
              unlabeled_set <- copy(unlabeled_pool)
              train_candidates = sample_selection(selected_ins, unlabeled_set, model_Sub)
              
              # eliminate candidates from the unlabeled pool
              unlabeled_pool = unlabeled_pool[-train_candidates$idx]
              rm(unlabeled_set)
              
              # run ABM to find outputs of train candidates
              print(paste0("ABM train_candidate run start time : ",Sys.time()))
              train_candidates = run_ABM(nofrep, selected_ins, train_candidates)
              print(paste0("ABM train_candidate run end time : ",Sys.time()))
              
              train_candidates_table = rbind(train_candidates_table, data.table(train_candidates,iter = iter))
              
              # add labeled candidates to the train data
              training_set_Ad = rbind(training_set_Ad, train_candidates[, -c("idx")])
              
              # update iteration_history
               iteration_history[iter]$IsDataSelected= 1
          }
          if (iter %in% feature_elimination_iteration_order) {
              ## feature elimination apply feature elimination
              feature_elimination_result = feature_elimination(h, total_numof_eliminated_vars, ranked_features)
              
              columns_left = feature_elimination_result[[1]]  # 
              eliminated_columns = feature_elimination_result[[4]]  #   not necessary
              total_numof_eliminated_vars = as.numeric(feature_elimination_result[2])
              numof_eliminated_vars = as.numeric(feature_elimination_result[3])  #   not necessary 
              
              # update iteration_history
              iteration_history[iter]$IsFeatureEliminated= 1
          }
    }
iter = iter + 1  
}
print(paste0("section end time : ",Sys.time()))

[1] "section start time : 2020-01-09 08:44:58"
[1] "ABM train_candidate run start time : 2020-01-09 08:44:58"
[1] "ABM train_candidate run end time : 2020-01-09 08:46:48"
[1] "ABM train_candidate run start time : 2020-01-09 08:46:48"
[1] "ABM train_candidate run end time : 2020-01-09 08:47:30"
[1] "ABM train_candidate run start time : 2020-01-09 08:47:30"
[1] "ABM train_candidate run end time : 2020-01-09 08:48:55"
[1] "ABM train_candidate run start time : 2020-01-09 08:48:55"
[1] "ABM train_candidate run end time : 2020-01-09 08:50:07"
[1] "ABM train_candidate run start time : 2020-01-09 08:50:07"
[1] "ABM train_candidate run end time : 2020-01-09 08:50:48"
[1] "ABM train_candidate run start time : 2020-01-09 08:50:48"
[1] "ABM train_candidate run end time : 2020-01-09 08:51:25"
[1] "ABM train_candidate run start time : 2020-01-09 08:51:25"
[1] "ABM train_candidate run end time : 2020-01-09 08:51:56"
[1] "ABM train_candidate run start time : 2020-01-09 08:51:56"
[1] "ABM train_candidate run end time : 2020-01-09 08:52:48"
[1] "ABM train_candidate run start time : 2020-01-09 08:52:49"
[1] "ABM train_candidate run end time : 2020-01-09 08:53:17"
[1] "ABM train_candidate run start time : 2020-01-09 08:53:17"
[1] "ABM train_candidate run end time : 2020-01-09 08:53:46"
[1] "ABM train_candidate run start time : 2020-01-09 08:53:46"
[1] "ABM train_candidate run end time : 2020-01-09 08:54:23"
[1] "ABM train_candidate run start time : 2020-01-09 08:54:23"
[1] "ABM train_candidate run end time : 2020-01-09 08:55:15"
[1] "ABM train_candidate run start time : 2020-01-09 08:55:15"
[1] "ABM train_candidate run end time : 2020-01-09 08:55:51"
[1] "ABM train_candidate run start time : 2020-01-09 08:55:52"
[1] "ABM train_candidate run end time : 2020-01-09 08:56:58"
[1] "ABM train_candidate run start time : 2020-01-09 08:56:59"
[1] "ABM train_candidate run end time : 2020-01-09 08:57:29"
[1] "ABM train_candidate run start time : 2020-01-09 08:57:29"
[1] "ABM train_candidate run end time : 2020-01-09 08:58:36"
[1] "ABM train_candidate run start time : 2020-01-09 08:58:36"
[1] "ABM train_candidate run end time : 2020-01-09 08:59:14"
[1] "ABM train_candidate run start time : 2020-01-09 08:59:15"
[1] "ABM train_candidate run end time : 2020-01-09 09:00:12"
[1] "ABM train_candidate run start time : 2020-01-09 09:00:13"
[1] "ABM train_candidate run end time : 2020-01-09 09:00:58"
[1] "ABM train_candidate run start time : 2020-01-09 09:00:58"
[1] "ABM train_candidate run end time : 2020-01-09 09:02:11"
[1] "section end time : 2020-01-09 09:02:11"

950 runs: "section start time : 2020-01-08 21:46:52" // "section end time : 2020-01-08 22:02:30"

#performance_error_table = performance_table[,.SD,.SDcols = c("iter",tolower(error_type))]
#setnames(performance_error_table,c("iter","error"))
#performance_error_table[, lag_error := shift(error,1,type = "lag")]
#performance_error_table
performance_error_table[.N]

columns_left

'%-similar-wanted'

# Final records
FinalTrainData_AdFe = copy(training_set_Ad)
performance_table_AdFe = copy(performance_table)
train_candidates_table_AdFe  = copy(train_candidates_table)
predictedLabels_table_AdFe = copy(predictedLabels_table)
obb_error_AdFe = copy(obb_error)

#fwrite(FinalTrainData_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/FinalTrainData_AdFe_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
#fwrite(performance_table_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/performance_table_AdFe_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
#fwrite(train_candidates_table_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/train_candidates_table_AdFe_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
#fwrite(predictedLabels_table_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/predictedLabels_table_AdFe_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )
#fwrite(obb_error_AdFe,paste0("C:/Users/paslanpatir/Desktop/TEZ_v2/obb_error_AdFe_BasicCode_Oneshot_120tree_",Sys.Date(),".csv") )

nrow(FinalTrainData_AdFe)
performance_table_AdFe
train_candidates_table_AdFe
head(predictedLabels_table_AdFe)
obb_error_AdFe

700

A data.table: 21 × 4

iter	mae	rmse	mape
<dbl>	<dbl>	<dbl>	<dbl>
1	2.098431	4.726630	3.057153
2	1.800111	4.104946	2.604973
3	1.671669	4.074645	2.442391
4	1.616238	3.829534	2.361563
5	1.547432	3.785836	2.266611
6	1.528220	3.809231	2.245446
7	1.471542	3.788896	2.155949
8	1.412366	3.799550	2.082855
9	1.350350	3.668667	1.982762
10	1.285588	3.678719	1.903817
11	1.276718	3.661909	1.883191
12	1.233828	3.650430	1.824850
13	1.210432	3.613287	1.795549
14	1.199528	3.624840	1.774160
15	1.173491	3.548542	1.751395
16	1.204442	3.594477	1.789988
17	1.168252	3.611806	1.741026
18	1.184417	3.622506	1.762875
19	1.167653	3.557843	1.727892
20	1.181067	3.553861	1.747526
21	6.177458	9.920150	9.183042

A data.table: 500 × 5

density	%-similar-wanted	idx	output	iter
<dbl>	<dbl>	<int>	<dbl>	<dbl>
79.18638	74.59114	511	83.15040	1
52.51502	74.99535	136	99.65931	1
66.32434	74.85613	195	99.68554	1
17.79868	75.83541	240	97.93158	1
70.47861	76.76088	60	54.22098	1
77.59878	77.15022	347	53.19967	1
38.04839	74.89497	270	99.81766	1
20.37012	75.14078	525	97.26971	1
66.09709	77.64091	576	56.93976	1
22.23156	89.17194	561	69.77342	1
21.60726	85.95121	416	76.28765	1
49.52896	75.20317	16	71.75775	1
44.18873	76.62527	247	73.35000	1
49.02309	77.00174	209	67.52525	1
51.83401	77.29802	581	61.30241	1
61.35303	75.38737	173	58.25268	1
54.75810	76.58287	306	60.59434	1
23.96343	87.89434	84	67.96242	1
82.76068	76.43015	154	52.51645	1
41.29254	75.91780	631	74.75397	1
88.90310	74.19145	8	78.95559	1
24.96805	74.65329	580	99.81138	1
32.15096	76.26948	460	79.22866	1
57.48774	75.70978	317	62.59604	1
19.79348	83.22548	649	79.84160	1
18.66068	86.56811	40	90.69240	2
17.95568	88.87073	674	93.97284	2
75.24774	75.33341	594	53.61023	2
33.83885	79.30846	179	83.16590	2
14.15759	13.42712	533	84.01118	2
...	...	...	...	...
83.37065	15.84925	175	54.37353	19
20.27116	41.38810	72	92.90771	19
83.30609	48.38970	249	87.55102	19
83.87123	19.49375	219	55.89841	19
48.54678	51.73439	121	96.81146	19
80.22550	59.66944	144	96.77803	20
80.33674	30.65946	75	72.31379	20
85.48583	30.82709	36	72.79090	20
88.70956	79.96555	111	51.79514	20
74.59872	31.15977	158	72.29091	20
77.94365	32.22095	174	73.20721	20
82.62886	31.92536	202	73.15475	20
62.25233	30.23400	195	73.72895	20
74.21415	11.90821	143	51.97770	20
89.52312	12.55836	60	52.00135	20
86.79071	18.78930	129	57.33783	20
77.20633	58.49839	197	96.69932	20
11.76210	72.89591	57	100.00000	20
41.02839	72.98888	112	99.77963	20
65.55228	32.46661	10	73.77327	20
23.02143	44.95784	70	93.52888	20
22.77537	41.71400	200	92.98051	20
60.69088	47.57684	52	88.37990	20
20.82692	46.90200	191	93.71813	20
73.47166	82.75609	181	52.64590	20
68.66339	31.01181	25	71.68456	20
80.85468	83.96997	54	50.69982	20
83.60280	84.49948	222	51.82716	20
72.47860	32.80387	83	72.48588	20
76.92746	12.88288	98	52.21979	20

A data.table: 6 × 45

density	%-similar-wanted	output	pred_output_1	RMSE_1	pred_output_2	RMSE_2	pred_output_3	RMSE_3	pred_output_4	...	pred_output_17	RMSE_17	pred_output_18	RMSE_18	pred_output_19	RMSE_19	pred_output_20	RMSE_20	pred_output_21	RMSE_21
<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	...	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>	<dbl>
39.27182	36.46039	86.97693	85.09648	1.88044819	84.86753	2.10939801	84.84484	2.13208250	86.76029	...	86.43323	0.54369261	86.63780	0.33913011	86.38733	0.58959547	86.23434	0.74258839	89.65268	2.6757550
28.12210	68.05564	99.86504	99.85598	0.00906429	99.83007	0.03496769	99.82913	0.03590878	99.85173	...	99.84632	0.01871931	99.83888	0.02616605	99.83172	0.03332532	99.85197	0.01307712	99.54716	0.3178800
75.80979	17.80044	57.77487	58.07941	0.30453968	58.34573	0.57086586	58.22285	0.44798702	57.51554	...	58.15841	0.38354372	58.15556	0.38069066	58.25973	0.48486101	58.23253	0.45766365	64.48567	6.7108004
57.76825	28.64345	73.81257	72.92002	0.89254967	73.08121	0.73135521	72.86951	0.94305308	72.68836	...	72.75960	1.05296103	72.64872	1.16384783	72.65373	1.15883640	72.62925	1.18331451	73.13006	0.6825033
18.53175	48.03778	93.79242	94.06373	0.27130985	94.14054	0.34811803	94.23337	0.44095303	94.60531	...	94.57201	0.77959132	94.55258	0.76016131	94.45080	0.65838530	94.56670	0.77428292	88.30976	5.4826549
80.09701	42.18455	82.70191	85.22908	2.52716574	85.23585	2.53393513	85.07763	2.37571997	85.18827	...	83.07912	0.37721153	83.21155	0.50964181	83.21401	0.51209509	83.11622	0.41431361	90.69839	7.9964760

A data.table: 21 × 2

iter	obb_error
<dbl>	<dbl>
1	15.080129
2	12.999502
3	11.485931
4	11.767707
5	9.527171
6	8.325295
7	7.559233
8	8.169771
9	6.837732
10	6.896286
11	6.375266
12	5.658079
13	4.932612
14	5.164344
15	5.641964
16	5.256454
17	4.737442
18	5.299231
19	4.452053
20	4.924206
21	119.262569

iteration_history

A data.table: 21 × 3

iter_no	IsFeatureEliminated	IsDataSelected
<dbl>	<dbl>	<dbl>
1	0	1
2	0	1
3	0	1
4	0	1
5	0	1
6	0	1
7	0	1
8	0	1
9	0	1
10	0	1
11	0	1
12	0	1
13	0	1
14	0	1
15	0	1
16	0	1
17	0	1
18	0	1
19	0	1
20	1	1
21	0	0

performance_molten_AdFe <- melt(data = performance_table_AdFe
                             , id.vars = 'iter')
setnames(performance_molten_AdFe, c("variable","value"),c("errortype","errorvalue"))
p_AdFe = ggplot(performance_molten_AdFe, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1) +
            geom_vline(xintercept = iteration_history[IsFeatureEliminated==1]$iter_no + 1, linetype = "dashed") +
            geom_vline(xintercept = iteration_history[IsDataSelected==1]$iter_no + 1, linetype = "dotdash",color = "yellow")
p_AdFe

Adaptive Sampling with/without Feature Elimination

performance_Ad_vs_AdFe = rbind(performance_molten_Ad[,.(iter,errortype,errorvalue, type = "Ad")], performance_molten_AdFe[,.(iter,errortype,errorvalue, type = "AdFe")])
p_Ad_vs_AdFe = ggplot(performance_Ad_vs_AdFe, aes(x = iter, y = errorvalue, group=errortype, col=errortype)) + 
            geom_line(lwd=1) +
            geom_vline(xintercept = iteration_history[IsFeatureEliminated==1]$iter_no + 1, linetype = "dashed") +
            geom_hline(data = performance_molten_oneshot, aes(yintercept = errorvalue, group=errortype, col=errortype),stat = "hline", linetype = "dashed") +
            facet_wrap(~type)
p_Ad_vs_AdFe

ggplotly(p_Ad_vs_AdFe)

#head(train_candidates_table_AdFe)
#head(train_candidates_table_Ad)

varImpPlot(model_Sub_1)

Quit NL

NLQuit(nl.obj = nl.model)
#NLQuit(all=FALSE)